Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Ken Long/Lightspeed-p-c/Symantec/Think Pascal/LightSpeed.p

Text File | 1994-12-04 | 11.6 KB | 464 lines | [TEXT/PJMM]

program LightSpeed;
    uses
        Sound, Palettes, ToolUtils, Resources, Windows;
    const
        MBarHeight = $BAA;            {Address of menubar height}
        HUDColor = blackColor;
        IndexColor = greenColor;
        starNumber = 40;            {Number of stars on the screen at one time}
        photonSnd = 9000;
        engineSnd = 9001;
    type
        IntPtr = ^integer;
        StarRecord = record
                h, v: extended;
                distance: extended;
            end;
        StarList = array[1..starNumber] of StarRecord;
    var
        stars: StarList;
        starsWindow: WindowPtr;
        dataHandle: Handle;
        currentPort: GrafPtr;
        starswindowRect: Rect;
        GrayRgn: RgnHandle;
        MBarHeightPtr: IntPtr;
        oldMBarHeight: Integer;
        mBarRgn: RgnHandle;
        colorList: array[0..2] of integer;
        TheEvent: EventRecord;

    function Randomize (high: Integer): extended;        {Random number}
{between -(high) and (high)}
        var
            rawResult: LONGINT;
    begin
        rawResult := Random;
        Randomize := ((rawResult * high) / 32768)
    end;

    function RandMinMax (low, high: extended): extended;        {Pos number}
{between low and high}
        var
            rawResult: LONGINT;
    begin
        rawResult := Random;
        RandMinMax := ABS(rawResult * (high - low) / 32768) + low
    end;

    function IntRandomize (high: Integer): Integer;                {Random}
{integer between 1 and high}
        var
            rawResult: LONGINT;
    begin
        rawResult := Random;
        IntRandomize := ABS((rawResult * high) div 32768)
    end;

    function Sgn (number: Integer): Integer;            {Signum function}
    begin
        Sgn := 0;
        if number > 0 then
            Sgn := 1;
        if number < 0 then
            Sgn := -1;
    end;

    procedure HideMenuBar;
        var
            mBarRect: Rect;
    begin
        oldMBarHeight := MBarHeightPtr^;
        MBarHeightPtr^ := 0;                                        { Make the}
{Menu bar's height zero }
        with qd.screenBits.bounds do
            SetRect(mBarRect, left, top, right, top + oldMBarHeight);
        mBarRgn := NewRgn;
        RectRgn(mBarRgn, mBarRect);
        UnionRgn(GrayRgn, mBarRgn, GrayRgn);  { Tell the desktop it}
{covers the menu bar }
        PaintOne(nil, mBarRgn);                    { redraw desktop }
    end;

    procedure ShowMenuBar;
    begin
        MBarHeightPtr^ := oldMBarHeight;
        DiffRgn(GrayRgn, mBarRgn, GrayRgn);        { remove the menu bar from}
{the desktop }
        DisposeRgn(mBarRgn)
    end;

    procedure CenterOrigin;
        var
            centerX, centerY: Integer;
    begin
        with currentPort^.portRect do
            begin
                centerX := -(ABS(right div 2));
                centerY := -(ABS(bottom div 2));
                SetOrigin(centerX, centerY)
            end
    end;

    procedure ClearScrn;
        var
            oldpenState, oldBkColor: Integer;
            winMgrPort: GrafPtr;
            menuRect: Rect;
    begin
        oldPenState := currentPort^.pnMode;
        GetWMgrPort(winMgrPort);
        oldBkColor := winMgrPort^.bkColor;
        SetPort(winMgrPort);
        BackColor(blackColor);
        SetRect(menuRect, 0, 0, qd.screenBits.bounds.right, 20);
        EraseRect(winMgrPort^.portRect);
        BackColor(oldBkColor);
        SetPort(currentPort)
    end;

    procedure MainLoop;
        const
            PhotonNum = 18;
            MaxDist = 24;
        type
            PhotonVector = record
                    h: extended;
                    v: extended;
                    psize: extended;
                end;
        var
            starColor: RGBColor;
            star, i, t: Integer;
            hPos, vPos: Integer;
            photon: array[1..PhotonNum] of PhotonVector;
            oldPhoton: PhotonVector;
            photonCount: Integer;
            oldpsize: extended;
            continue, past, offscreen: BOOLEAN;
            shipSpeed, dist: extended;
            starRect: Rect;
            windowWidth, windowHight, midH, midV: Integer;
            mouseLoc, oldmouseLoc: Point;
            hOffset, vOffset: Integer;
            hRect, vRect: Rect;
            engineSound, photonSound: Handle;
            soundChannel: SndChannelPtr;
            stopCommand: SndCommand;
            err: OSErr;
        procedure MakeRect (h, v: extended; distance: extended; var theRect: Rect);
            var
                size: Integer;
        begin
            with theRect do
                begin
                    size := ROUND(MaxDist / (distance + 0.01));
                    left := ROUND(h);
                    top := ROUND(v);
                    right := left + size;
                    bottom := top + size;
                    OffsetRect(theRect, -(size div 2), -(size div 2));
                end
        end;
        procedure LoadStars;
            var
                star: Integer;
                starRect: Rect;
        begin
            for star := 1 to starNumber do
                begin
                    stars[star].h := Randomize(midH);
                    stars[star].v := Randomize(midV);
                    stars[star].distance := RandMinMax(3, MaxDist);
                    MakeRect(stars[star].h, stars[star].v, stars[star].distance, starRect);
                    InvertOval(starRect)
                end
        end;
        procedure DoMouseDown;
        begin
            if photonCount < 10 then
                begin
                    err := SndDoImmediate(soundChannel, stopCommand);
                    err := SndPlay(soundChannel, photonSound, TRUE);
                    photon[photonCount + 1].h := -midH;
                    photon[photonCount + 1].v := midV;
                    photon[photonCount + 2].h := midH;
                    photon[photonCount + 2].v := midV;
                    photon[photonCount + 1].psize := 48;
                    photon[photonCount + 2].psize := 48;
                    photonCount := photonCount + 2;
                end
        end;
        procedure DoKeyDown;
            var
                chCode: Integer;
                theChar: char;
        begin
            chCode := BitAnd(TheEvent.message, CharCodeMask);
            theChar := CHR(chCode);
            if theChar = '+' then
                shipSpeed := shipSpeed + 0.1;
            if theChar = '-' then
                shipSpeed := shipSpeed - 0.1;
            if (theChar = 'q') or (theChar = 'Q') then
                continue := FALSE;
            if theChar = ' ' then
                DoMouseDown;
            if theChar = '4' then
                hPos := hPos - 5;
            if theChar = '7' then
                begin
                    vPos := vPos + 5;
                    hPos := hPos - 5;
                end;
            if theChar = '8' then
                vPos := vPos + 5;
            if theChar = '9' then
                begin
                    vPos := vPos + 5;
                    hPos := hPos + 5;
                end;
            if theChar = '6' then
                hPos := hPos + 5;
            if theChar = '3' then
                begin
                    vPos := vPos - 5;
                    hPos := hPos + 5;
                end;
            if theChar = '2' then
                vPos := vPos - 5;
            if theChar = '1' then
                begin
                    vPos := vPos - 5;
                    hPos := hPos - 5;
                end;
            if theChar = '5' then
                begin
                    vPos := 0;
                    hPos := 0
                end;
        end;
        procedure DrawPhoton (h, v, psize: extended);
            var
                t, offset, offset2: Integer;
                h2, v2: Integer;
                photonRect: Rect;
        begin
            h2 := ROUND(h);
            v2 := ROUND(v);
            for t := 0 to 4 do
                begin
                    ForeColor(colorList[ABS(IntRandomize(3))]);
                    offset := ROUND(SIN(psize + t) * psize);
                    offset2 := ROUND(SIN((psize + t) * 2) * psize);
                    MoveTo(h2 - offset, v2 - offset2);
                    LineTo(h2 + offset, v2 + offset2)
                end;
        end;
    begin        (*Main Loop*)
        CenterOrigin;
        colorList[0] := blueColor;
        colorList[1] := blueColor;
        colorList[2] := cyanColor;
        BackColor(blackColor);
        with currentPort^.portRect do
            begin
                windowWidth := (right - left);
                windowHight := (bottom - top)
            end;
        midH := windowWidth div 2;
        midV := windowHight div 2;
        LoadStars;
        ForeColor(HUDColor);
        PenNormal;
        PenPat(qd.black);
        engineSound := GetResource('snd ', engineSnd);
        photonSound := GetResource('snd ', photonSnd);
        with stopCommand do
            begin
                cmd := quietCmd;
                param1 := 0;
                param2 := 0;
            end;
        soundChannel := nil;
        err := SndNewChannel(soundChannel, sampledSynth, initMono, nil);
        continue := TRUE;
        photonCount := 0;
        shipSpeed := 0;
        hPos := 0;
        vPos := 0;
        with starColor do
            begin
                red := $AAAA;
                green := $AAAA;
                blue := $BBBB;
            end;
        SetEventMask(mDownMask + keyDownMask + autoKeyMask);
        GetMouse(oldmouseLoc);
        while continue do
            begin
                if GetNextEvent(EveryEvent, TheEvent) then
                    case TheEvent.what of
                        mouseDown:
                            DoMouseDown;
                        keyDown:
                            DoKeyDown;
                        autoKey:
                            DoKeyDown;
                        otherwise
                            ;
                    end;
                GetMouse(mouseLoc);
                if not EqualPt(mouseLoc, oldmouseLoc) then
                    begin
                        hPos := hPos + (mouseLoc.h - oldmouseLoc.h);
                        vPos := vPos + (mouseLoc.v - oldmouseLoc.v);
                        oldmouseLoc := mouseLoc;
                    end;
                ForeColor(IndexColor);
                PenMode(SrcCopy);
                if ABS(hPos) > (midH - 2) then
                    hPos := Sgn(hPos) * (midH - 2);
                if ABS(vPos) > (midV - 2) then
                    vPos := Sgn(vPos) * (midV - 2);
                vRect.left := -(midH);
                vRect.right := -(midH) + 8;
                vRect.top := vPos;
                vRect.bottom := vPos + 2;
                PaintRect(vRect);
                hRect.bottom := midV;
                hRect.top := midV - 8;
                hRect.left := hPos;
                hRect.right := hPos + 2;
                PaintRect(hRect);
                hOffset := -hPos;
                vOffset := vPos;
                PenMode(SrcCopy);
                if photonCount > 0 then
                    begin
                        PenMode(SrcCopy);
                        for i := 1 to photonCount do
                            DrawPhoton(photon[i].h, photon[i].v, photon[i].psize);
                    end;
                for star := 1 to starNumber do            {Calculate new star}
{position, if star out of window, reset it}
                    begin
                        MakeRect(stars[star].h, stars[star].v, stars[star].distance, starRect);
                        EraseOval(starRect);
                        if (shipSpeed < 0) and (stars[star].distance >= MaxDist) then
                            past := TRUE;
                        if (shipSpeed > 0) and (stars[star].distance <= 0) then
                            past := TRUE;
                        if (ABS(stars[star].v) > midV) or (ABS(stars[star].h) > midH) then
                            offscreen := TRUE;
                        if (past or offscreen) then
                            begin            {new star}
                                past := FALSE;
                                offscreen := FALSE;
                                if shipSpeed >= 0 then
                                    begin
                                        stars[star].v := Randomize(midV - 10);
                                        stars[star].h := Randomize(midH - 10);
                                        stars[star].distance := maxDist;
                                    end
                                else            {shipSpeed < 0}
                                    case IntRandomize(3) of
                                        1:
                                            begin
                                                if IntRandomize(2) = 1 then
                                                    stars[star].v := midV
                                                else
                                                    stars[star].v := -midV;
                                                stars[star].h := Randomize(midH);
                                                stars[star].distance := RandMinMax(2, MaxDist - 1);
                                            end;
                                        2:
                                            begin
                                                stars[star].v := Randomize(midV);
                                                if IntRandomize(2) = 1 then
                                                    stars[star].h := midH
                                                else
                                                    stars[star].h := -midH;
                                                stars[star].distance := RandMinMax(2, MaxDist - 1);
                                            end;
                                    end
                            end            {new star}
                        else
                            begin
                                dist := 6 * stars[star].distance;                {How much distance}
{affects apparent speed}
                                stars[star].h := stars[star].h * (shipSpeed + dist) / dist + (hOffset div 8);
                                stars[star].v := stars[star].v * (shipSpeed + dist) / dist + (vOffset div 6);
                                stars[star].distance := stars[star].distance - (shipSpeed / 6);
                            end;
                        MakeRect(stars[star].h, stars[star].v, stars[star].distance, starRect);
                        RGBForeColor(starColor);
                        PaintOval(starRect);
                    end;
                PenPat(qd.gray);
                ForeColor(yellowColor);
                i := 0;
                while i < midH do
                    begin
                        i := i + 50;
                        MoveTo(i, -5);
                        Line(0, 10);
                        MoveTo(-i, -5);
                        Line(0, 10);
                    end;
                i := 0;
                while i < midV do
                    begin
                        i := i + 50;
                        MoveTo(-5, i);
                        Line(10, 0);
                        MoveTo(-5, -i);
                        Line(10, 0);
                    end;
                PenNormal;
                if photonCount > 0 then
                    begin
                        PenMode(SrcBic);
                        for i := 1 to photonCount do
                            begin
                                oldphoton := photon[i];
                                photon[i].h := photon[i].h * 0.86 + (hOffset div 8);
                                photon[i].v := photon[i].v * 0.86 + (vOffset div 6);
                                DrawPhoton(oldphoton.h, oldphoton.v, oldphoton.psize);
                                oldpsize := photon[i].psize;
                                photon[i].psize := photon[i].psize * 0.9;
                                if ABS(oldpsize - photon[i].psize) < 0.09 then
                                    begin
                                        for t := i to (photonCount - 1) do
                                            photon[t] := photon[t + 1];
                                        photonCount := photonCount - 1;
                                    end;
                            end;
                    end;
                EraseRect(hRect);
                EraseRect(vRect);
            end;
        ReleaseResource(photonSound);
        ReleaseResource(engineSound);
        err := SndDisposeChannel(soundChannel, TRUE);
        FlushEvents(everyEvent, 0);
    end;

begin        (*Main Block*)
    with qd.screenBits.bounds do
        begin
            MBarHeightPtr := IntPtr(MBarHeight);
            GrayRgn := GetGrayRgn;
            HideMenuBar;
            starsWindow := NewCWindow(nil, qd.screenBits.bounds, 'LightSpeed', TRUE, NoGrowDocProc, WindowPtr(-1), FALSE, LONGINT(dataHandle));
            SetPort(starsWindow);
        end;
    GetPort(currentPort);
    ClearScrn;
    HideCursor;
    MainLoop;
    ShowCursor;
    ShowMenuBar;
    FlushEvents(MDownMask, 0)            {Clear Event Queue of all mouseDown}
{events}
end.